home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / folder / folders.bas < prev    next >
BASIC Source File  |  1995-05-09  |  11KB  |  379 lines
  1. Option Explicit
  2.  
  3. Const TabOffsetConstant = 4
  4.  
  5. Dim Folders() As Control      ' Array of the form's folders
  6. Global FolderNum As Integer   ' Current active folder
  7. Global NumFolders As Integer  ' Total number of folders
  8.  
  9. Dim VisibleTabs As Integer    ' Number of tabs across screen
  10. Dim OneTabHeight As Integer   ' Height of one row of tabs
  11. Dim FolderTabs As Control     ' Picture to paint tabs on
  12. Dim TabWidth As Long          ' Tab width
  13. Dim NumRows As Integer        ' Number of rows of tabs
  14. Dim TabOffset As Integer      ' # of pixels for tab's diagonal
  15. Dim TabOffsetX As Integer     ' Offset translated to x-twips
  16. Dim TabOffsetY As Integer     ' Offset translated to y-twips
  17.  
  18. 'Used for border/menu sizes
  19. Declare Function GetSystemMetrics% Lib "User" (ByVal nIndex%)
  20. 'Used to see if menu is used
  21. Declare Function GetMenu Lib "User" (ByVal hWnd%) As Integer
  22.  
  23. ' Locate the folder controls
  24. ' Set the Folders array to point to the folders
  25. ' Modify each folder to match the first folder (index=0)
  26. Function DefineFolders (NumAcross As Integer, Fldr As Control, FolderTabControl As Control) As Integer
  27. Dim I As Integer
  28.  
  29.   ' Find out how many folders in an array are on the form
  30.   ' Done by checking each control to see if it is a folder
  31.   '   and then checking each folder to see if it has an index
  32.   '   value (part of an array of folders)
  33.   NumFolders = 0
  34.   On Error GoTo NoIndex
  35.   For I = 0 To Fldr.Parent.Controls.Count - 1
  36.     If TypeOf Fldr.Parent.Controls(I) Is Frame Then
  37.       If Not Fldr.Parent.Controls(I).Index >= 0 Then
  38.     ' Fill Space
  39.       Else
  40.     If Fldr.Parent.Controls(I).Index > NumFolders Then NumFolders = Fldr.Parent.Controls(I).Index
  41.       End If
  42.     End If
  43.   Next I
  44.   On Error GoTo 0
  45.   
  46.   ' Fill the Folders array with pointers to the folder
  47.   '   on the form
  48.   ' Done by the same loop as last time, but this time
  49.   '   I assign it to an array
  50.   ReDim Folders(NumFolders)
  51.   On Error GoTo NoIndex
  52.   For I = 0 To Fldr.Parent.Controls.Count - 1
  53.     If TypeOf Fldr.Parent.Controls(I) Is Frame Then
  54.       If Not Fldr.Parent.Controls(I).Index >= 0 Then
  55.     'Fill Space
  56.       Else
  57.     On Error GoTo 0
  58.     Set Folders(Fldr.Parent.Controls(I).Index) = Fldr.Parent.Controls(I)
  59.     On Error GoTo NoIndex
  60.       End If
  61.     End If
  62.   Next I
  63.   On Error GoTo 0
  64.   
  65.   ' Define Standard variables
  66.   If NumAcross = 0 Then
  67.     VisibleTabs = NumFolders + 1
  68.   Else
  69.     VisibleTabs = NumAcross
  70.   End If
  71.   TabOffset = TabOffsetConstant
  72.   SetTabOffset -TabOffset
  73.   
  74.   'Modify all the folders to match folder0
  75.   For I = 0 To NumFolders
  76.     Folders(I).Top = Folders(0).Top
  77.     Folders(I).Left = Folders(0).Left
  78.     Folders(I).Width = Folders(0).Width
  79.     Folders(I).Height = Folders(0).Height
  80.     Folders(I).BackColor = Folders(0).BackColor
  81.     Folders(I).Tag = Folders(I).Caption
  82.     Folders(I).FontBold = False
  83.     Folders(I).FontItalic = Folders(0).FontItalic
  84.     Folders(I).FontName = Folders(0).FontName
  85.     Folders(I).FontSize = Folders(0).FontSize
  86.     Folders(I).FontStrikethru = Folders(0).FontStrikethru
  87.     Folders(I).FontUnderline = Folders(0).FontUnderline
  88.     Folders(I).ForeColor = Folders(0).ForeColor
  89.     Folders(I).Visible = True
  90.     Folders(I).ZOrder 1
  91.   Next I
  92.   FolderNum = 0  ' Start with the first folder highlighted
  93.          ' If you want a different first folder, use
  94.          '   the GotoFolder function right after you
  95.          '   use DefineFolders
  96.   
  97.   'Fldr.Parent.Show
  98.   DefineTabs FolderTabControl   ' Configure the tab picture box
  99.   Call ShowFolder  ' Move the first folder to the top
  100.  
  101.   Exit Function
  102. NoIndex:
  103.   Resume Next
  104.  
  105. End Function
  106.  
  107. ' Initialize the picture box that the
  108. '   folder tabs are drawn in
  109. Private Sub DefineTabs (FolderTabControl As Control)
  110.  
  111.   ' Calculate the number of rows needed to display all tabs
  112.   NumRows = NumFolders \ VisibleTabs + 1
  113.  
  114.   ' Set the picture box's properties
  115.   Set FolderTabs = FolderTabControl
  116.   FolderTabs.AutoSize = False
  117.   FolderTabs.ScaleMode = 1
  118.   FolderTabs.Left = Folders(0).Left
  119.   FolderTabs.Width = Folders(0).Width
  120.   TabWidth = (FolderTabs.Width \ VisibleTabs)
  121.   FolderTabs.AutoRedraw = True
  122.   FolderTabs.BackColor = Folders(0).BackColor
  123.   FolderTabs.BorderStyle = 0
  124.   FolderTabs.DragMode = 0
  125.   FolderTabs.Enabled = True
  126.   FolderTabs.FillStyle = 0
  127.   FolderTabs.DrawStyle = 0
  128.   FolderTabs.FontBold = Folders(0).FontBold
  129.   FolderTabs.FontBold = Folders(0).FontBold
  130.   FolderTabs.FontItalic = Folders(0).FontItalic
  131.   FolderTabs.FontName = Folders(0).FontName
  132.   FolderTabs.FontSize = Folders(0).FontSize
  133.   FolderTabs.FontStrikethru = Folders(0).FontStrikethru
  134.   FolderTabs.FontUnderline = Folders(0).FontUnderline
  135.   FolderTabs.ForeColor = Folders(0).ForeColor
  136.   FolderTabs.LinkMode = 0
  137.   FolderTabs.MousePointer = 0
  138.   FolderTabs.TabStop = False
  139.   FolderTabs.Visible = True
  140.   FolderTabs.ZOrder 0
  141.   
  142.  
  143.   ' Calculate the tab height based on the height of a sample
  144.   '   letter + the offset height
  145.   OneTabHeight = (FolderTabs.TextHeight("X") + TabOffsetY)
  146.   FolderTabs.Height = OneTabHeight * NumRows
  147.   FolderTabs.Top = Folders(0).Top - FolderTabs.Height + OneTabHeight
  148.  
  149. End Sub
  150.  
  151. ' Draws a single folder tab
  152. ' TabNumber = the tab that is being drawn
  153. ' HorPos = the tabs horizontal position on the folders
  154. ' VerPos = the row the tab is on
  155. ' Foreground = True if it is the currently selected tab
  156. Private Sub DrawTab (TabNumber As Integer, HorPos As Integer, VerPos As Integer, ForeGround As Integer)
  157. Dim TabTextWidth As Long
  158. Dim L%, R%, T%, B%
  159.  
  160.   ' Set the Top/Bottom/Left/Right values of the single tab
  161.   T = FolderTabs.Height - VerPos * OneTabHeight
  162.   B = T + OneTabHeight - TwipsY(1)
  163.   L = TabWidth * HorPos
  164.   R = L + TabWidth - TwipsX(1)
  165.   
  166.   ' Draw the lines around the tab
  167.   FolderTabs.Line (L, B)-(L, T + TabOffsetY), 0
  168.   
  169.   ' If you reverse the comments in the next three lines, you will
  170.   '   get a rounded top-left corner (not very noticable)
  171.   'FolderTabs.Circle Step(TabOffsetX, 0), TabOffsetX, 0, 3.141 / 2, 3.141
  172.   'FolderTabs.CurrentY = T
  173.   FolderTabs.Line -(L + TabOffsetX, T), 0
  174.   
  175.   FolderTabs.Line -(R - TabOffsetX, T), 0
  176.   
  177.   ' If you reverse the comments in the next three lines, you will
  178.   '   get a rounded top-right corner (not very noticable)
  179.   'FolderTabs.Circle Step(0, TabOffsetY), TabOffsetX, 0, 0, 3.141 / 2
  180.   'FolderTabs.CurrentX = R
  181.   FolderTabs.Line -(R, T + TabOffsetY), 0
  182.   
  183.   FolderTabs.Line -(R, B), 0
  184.   
  185.   ' If it is the selected folder, draw a blank line underneath
  186.   If ForeGround Then FolderTabs.Line -(L, B), FolderTabs.BackColor
  187.   
  188.   ' Print the tab's title (bold if foreground)
  189.   FolderTabs.FontBold = ForeGround
  190.   TabTextWidth = FolderTabs.TextWidth(Folders(TabNumber).Caption)
  191.   FolderTabs.CurrentX = (TabWidth * HorPos) + (TabWidth \ 2) - (TabTextWidth \ 2)
  192.   FolderTabs.CurrentY = T + (TabOffsetY \ 2)
  193.   FolderTabs.Print Folders(TabNumber).Caption
  194.   FolderTabs.FontBold = False
  195.  
  196. End Sub
  197.  
  198. ' Draws each of the visible tabs on screen
  199. Private Sub DrawTabs ()
  200. Dim I As Integer
  201.   
  202.   FolderTabs.Cls
  203.   
  204.   ' Draws the lines below the tabs first
  205.   For I = 1 To NumRows
  206.     FolderTabs.Line (0, I * OneTabHeight - TwipsY(1))-(FolderTabs.Width, I * OneTabHeight - TwipsY(1)), 0
  207.   Next I
  208.  
  209.   ' Draw each tab
  210.   For I = 0 To NumFolders
  211.     DrawTab I, HorTabPos(I), VerTabPos(I), I = FolderNum
  212.   Next I
  213.  
  214.   ' Draw lines down the left and right side
  215.   FolderTabs.Line (0, TabOffsetY)-(0, FolderTabs.Height - TwipsY(1)), 0
  216.   FolderTabs.Line (FolderTabs.Width - TwipsX(1), FolderTabs.Height - TwipsY(1))-(FolderTabs.Width - TwipsX(1), OneTabHeight - TwipsY(1)), 0
  217.  
  218. End Sub
  219.  
  220. ' Jump to the folder tab that was clicked on
  221. ' This is called by the Tab picture box's MouseDown procedure
  222. Sub FolderClick (Button As Integer, X As Single, Y As Single)
  223. Dim HorPos As Integer
  224. Dim VerPos As Integer
  225.  
  226.   
  227.   HorPos = X \ (FolderTabs.Width \ VisibleTabs)
  228.   VerPos = NumRows - (Y \ (FolderTabs.Height \ NumRows)) - 1
  229.   VerPos = (VerPos + (FolderNum \ VisibleTabs + 1)) Mod NumRows - 1
  230.   If VerPos = -1 Then VerPos = NumRows - 1
  231.   
  232.   GotoFolder (VerPos * VisibleTabs) + HorPos
  233.  
  234. End Sub
  235.  
  236. ' Make FolderNumber the active fold